{
	Barcode_p.pas
	Copyright (C) 2012 Keagan Ladds

    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
}


unit Barcode_p;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, pCore2D, pBarcode2D, pQRCode, StdCtrls, ComCtrls, ExtCtrls, Printers,
  JPEG, Spin;

type
  TForm1 = class(TForm)
    Barcode2D_QRCode1: TBarcode2D_QRCode;
    Button3: TButton;
    Barcode2D_QRCode2: TBarcode2D_QRCode;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    Label1: TLabel;
    edtUUID: TEdit;
    edtSiteID: TEdit;
    Label2: TLabel;
    Image1: TImage;
    Image2: TImage;
    TabSheet2: TTabSheet;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    sedBCount: TSpinEdit;
    sedBStart: TSpinEdit;
    sedSStart: TSpinEdit;
    sedHPS: TSpinEdit;
    Label7: TLabel;
    Label8: TLabel;
    sedHStart: TSpinEdit;
    sedSPH: TSpinEdit;
    Button2: TButton;
    Label9: TLabel;
    Label10: TLabel;
    lblHiveID: TLabel;
    lblSiteID: TLabel;
    Button4: TButton;
    PrintDialog1: TPrintDialog;
    Label11: TLabel;
    sedSIndex: TSpinEdit;
    Button5: TButton;
    Label12: TLabel;
    sedHIndex: TSpinEdit;
    Label13: TLabel;
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure edtUUIDChange(Sender: TObject);
    procedure edtSiteIDChange(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
  private
    bBusy : boolean;
    function InttoStrPadded(x : integer; PadCount : integer) : string;
  public
    { Public declarations }
  end;
  
var
  Form1: TForm1;

const DEMO = false; //This is used to impliment 'Trial Mode'
const DEMO_DATE = '2011/12/26';

implementation

{$R *.dfm}

procedure SetPrinterSettings(FPrinter: TPrinter);
var
  FDevice: PChar;
  FDriver: PChar;
  FPort: PChar;
  DeviceMode: THandle;
  DevMode: PDeviceMode;
begin
  {to get a current printer settings}
  FPrinter.GetPrinter(FDevice, FDriver, FPort, DeviceMode);
  {lock a printer device}
  DevMode := GlobalLock(DeviceMode);

  {set a paper size as A4-Transverse}
  if ((DevMode^.dmFields and DM_PAPERLENGTH) = DM_PAPERLENGTH) then
  begin
    DevMode^.dmFields := DevMode^.dmFields or DM_PAPERLENGTH;

    DevMode^.dmPaperLength := 100;
  end;

  {set a printer settings}
  FPrinter.SetPrinter(FDevice, FDriver, FPort, DeviceMode);

  {unlock a device}
  GlobalUnlock(DeviceMode);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  Uid: TGuid;
begin
  CreateGuid(Uid);
  edtUUID.Text := GuidToString(Uid);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  Print : TPrinter;
  k : integer;
  sBarcodeID, sHiveID, sSiteID, sHubID : string;
  iSiteCount, iHubCount, iSitesPerHub, iHivesPerSite, iSiteStart, iBarcodeStart, iHubStart, iTempSiteID, iTemp, iTempTwo : integer;
  tfTemp : TextFile;
begin
  bBusy := true;
  AssignFile(tfTemp, 'Temp.txt');
  Rewrite(tfTemp);
  iSitesPerHub := sedSPH.Value;
  iHivesPerSite := sedHPS.Value;
  iSiteStart := sedSStart.Value;
  iBarcodeStart := sedBStart.Value;
  iHubStart := sedHStart.Value;
  iHubCount := 0;
  iSiteCount := 0;

  iTempSiteID := 0;
  iTemp := sedSIndex.Value;
  iTempTwo := sedHIndex.Value;

   if(MessageBox(Handle, 'Please Ensure that the printer cartridge is full before starting print!!!',  'Continue?', MB_YESNO) <> MRYES) then
    exit;

   self.PrintDialog1.Execute();

  //SetPrinterSettings(Print);
  Printer.BeginDoc;

  for k := 0 to sedBCount.Value - 1 do
    begin
        sBarcodeID := InttostrPadded(k + 1 + iBarcodeStart, 8);
        iSiteCount := ((k - 1) DIV iHivesPerSite);
        //iHubCount := (iSiteCount DIV iSitesPerHub);
        if(iTemp = iSitesPerHub) then
        begin
          inc(iTempSiteID);
          iTemp := 0;
        end;

        if(iTempTwo = iSitesPerHub * iHivesPerSite) then
        begin
          inc(iHubCount);
          iTempTwo := 0;
        end;
        inc(iTemp);
        inc(iTempTwo);
        sSiteID := InttostrPadded((iTempSiteID) + iSiteStart + 1, 4); 
        sHubID := InttostrPadded(iHubCount + iHubStart + 1, 4);
        sSiteID := 'S' +  sSiteID + 'H' + sHubID;
        writeln(tfTemp, sBarcodeID + ' : ' + sSiteID);
        Barcode2D_QRCode1.Barcode := sBarcodeID;
        Barcode2D_QRCode2.Barcode := sSiteID;
        lblHiveID.Caption := sBarcodeID;
        lblSiteID.Caption := sSiteID;


         if(not Printer.Aborted) AND (Printer.Printing) then
         begin
        
        Printer.Canvas.Draw(0,0,Image1.Picture.Graphic);
        //Printer.Canvas.Font.Style := Print.Canvas.Font.Style +[fsUnderline]; //Program crashes with Access Violation Error - REASON: UNKNOWN
        Printer.Canvas.TextOut(110,0, 'Hive ID');
        //Printer.Canvas.Font.Style := Print.Canvas.Font.Style -[fsUnderline];
        Printer.Canvas.TextOut(110,30, sBarcodeID);
        

        Printer.Canvas.Draw(220,0,Image2.Picture.Graphic);
        //Printer.Canvas.Font.Style :=  Print.Canvas.Font.Style +[fsUnderline]; //Program crashes with Access Violation Error - REASON: UNKNOWN
        Printer.Canvas.TextOut(330,0, 'Site ID');
        //Printer.Canvas.Font.Style :=  Print.Canvas.Font.Style -[fsUnderline];
        Printer.Canvas.TextOut(330,30, sSiteID);
        Printer.NewPage;
         end;


        Application.ProcessMessages;
        Sleep(100);

     if(bBusy = false) then
     begin
      ShowMessage('Operation Aborted!!!');
      exit;
     end;


    end;
    Printer.EndDoc;
    closeFile(tfTemp);
    ShowMessage('Printing Complete');
    bBusy := false;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
  Print : TPrinter;
begin
 self.PrintDialog1.Execute();
 //SetPrinterSettings(Print);
 Printer.BeginDoc;
 Printer.Canvas.Draw(0,0,Image1.Picture.Graphic);
 //Print.Canvas.Font.Style := Print.Canvas.Font.Style +[fsUnderline]; //Program crashes with Access Violation Error - REASON: UNKNOWN
 Printer.Canvas.TextOut(150,0, 'Hive ID');
 //Print.Canvas.Font.Style := Print.Canvas.Font.Style -[fsUnderline];
 Printer.Canvas.TextOut(150,30, Copy(edtUUID.Text, 1, Length(edtUUID.Text) div 2));
 Print.Canvas.TextOut(150,60, Copy(edtUUID.Text, (Length(edtUUID.Text) div 2) + 1, Length(edtUUID.Text)));

 Printer.Canvas.Draw(400,0,Image2.Picture.Graphic);
 //Print.Canvas.Font.Style :=  Print.Canvas.Font.Style +[fsUnderline];  //Program crashes with Access Violation Error - REASON: UNKNOWN
 Printer.Canvas.TextOut(550,0, 'Site ID');
 //rint.Canvas.Font.Style :=  Print.Canvas.Font.Style -[fsUnderline];
 Printer.Canvas.TextOut(550,30, edtSiteID.Text);
 Print.EndDoc;



end;

procedure TForm1.Button4Click(Sender: TObject);
begin
  bBusy := false;
end;

procedure TForm1.Button5Click(Sender: TObject);
var
  HID, SID : string;
begin
  HID := InputBox('Enter Data Please', 'Please Enter The Last Hive ID:', '');
  SID := InputBox('Enter Data Please', 'Please Enter The Last Site ID:', '');

  if(Length(HID) = 8) AND (Length(SID) = 10) then
  begin
     sedBStart.Value := strtoint(HID);
     sedSIndex.Value := strtoint(HID[Length(HID)]);

     sedSStart.Value := strtoint(Copy(SID, 2, 4)) - 1;
     sedHStart.Value := strtoint(Copy(SID, 7, 4)) - 1;

     sedHIndex.Value := strtoint(Copy(HID, 7, 2));
  end;
end;

procedure TForm1.edtSiteIDChange(Sender: TObject);
begin
  Barcode2D_QRCode2.Barcode := edtSiteID.Text;
end;

procedure TForm1.edtUUIDChange(Sender: TObject);
begin
  Barcode2D_QRCode1.Barcode := edtUUID.Text;
end;

///////////////////////////////////////////////////////////////////////////////////////////
// InttoStrPadded
//// Convert Integer to string and n amount of '0' padding to the start of string
///////////////////////////////////////////////////////////////////////////////////////////
function TForm1.InttoStrPadded(x, PadCount: integer): string;
var
  k : integer;
  sTemp, sNum : string;
begin
  sNum := inttostr(x);
  for k := 1 to PadCount - Length(sNum) do
   begin 
     sTemp := sTemp + '0';
   end;

   result := sTemp + sNum;
end;

//////////////////////////////////////////////////////////////////////////////////////////
// Form Activate
//// Check if this program is in trial mode, if so check if the trial period has expired. 
//// Close program if trial period has ened
//////////////////////////////////////////////////////////////////////////////////////////
procedure TForm1.FormActivate(Sender: TObject);
var
  dateExpire : TDateTime;
begin
   if DEMO = true then
   begin
	dateExpire := strtodate(DEMO_DATE);

      if(Now >= dateExpire) then
        begin
          MessageBox(Handle, 'The Demo license for the application has expired, you can no longer make use of this software. Please contact Keagan Ladds to obtain a full version of this program', 'License Expired', MB_OK);
          close();
        end
      else
      begin
         MessageBox(Handle, 'This application is a trial version. Please contact Keagan Ladds to obtain a full version of this program', 'License Information', MB_OK);
         self.Caption := self.Caption + ' - TRIAL EDITION';
      end;
   end;
end;

end.
